home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
storage.zip
/
STORTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-02-09
|
4KB
|
136 lines
Program StorageTest;
{ This program will demonstrate the ability to save and restore text info
in an indexed file that is also Network aware. This should be interesting
---------------------------------------------------------------------------
If you have any suggestions or improvments on this file or its usage, or
would just like to chat, you can reach me at the following:
Marcos R. Della
5084 Rincon Ave.
Santa Rosa, CA 95409
CIS: 71675,765
---------------------------------------------------------------------------}
Uses Dos, Crt, Storage, Objects;
VAR T : TStorage;
st1 : STRING; {Kind of a pseudo buffer}
st2 : STRING; {Another pseudo buffer}
st3 : STRING;
p : POINTER; {Pointer to the return character buffer}
idx1 : LONGINT;
idx2 : LONGINT;
idx3 : LONGINT;
loop : WORD;
count : WORD;
ch : CHAR;
TYPE charbuf = Array[1..65530] OF char;
BEGIN
CLRSCR;
st1 := 'Now is the time for all good men to come to the aid of their '
+ 'country before the last of the Mohecians take over the world as '
+ 'we now know it. This might be a very detrimental accident if '
+ 'it is allowed to happen';
st2 := 'This is a message that will test the deletion function.';
st3 := 'This message will survive the compression and deletion!';
T.Init('TESTFILE.DAT',stOpenWrite,512);
IF T.ErrorInfo = 2 THEN {File Does Not Exist}
BEGIN
T.Done;
T.Init('TESTFILE.DAT',stCreate,512)
END;
WriteLn('Filename: ',T.SFileName);
WriteLn('Mode: ',T.SMode);
idx1 := T.WriteMsg(LENGTH(st1),st1[1]); {Our actual buffer is from 1..till we hit the NULL}
IF T.Status <> stOk THEN {Do your real error checking here if you are}
T.Reset; {really interested}
WriteLn('1st Index: ',idx1);
idx2 := T.WriteMsg(LENGTH(st2),st2[1]);
IF T.Status <> stOk THEN
T.Reset;
Writeln('2nd Index: ',idx2);
idx3 := T.WriteMsg(LENGTH(st3),st3[1]);
IF T.Status <> stOk THEN
T.Reset;
Writeln('3nd Index: ',idx3);
WriteLn;
T.DeleteMsg(idx2);
WriteLn('First Deletion Attempt (Write Only): ',T.ErrorInfo);
IF T.Status <> stOk THEN
T.Reset;
T.Done;
T.Init('TESTFILE.DAT',stOpen,128);
T.DeleteMsg(idx2); {Must be open for read/write!}
WriteLn('Second Deletion Attempt (Read/Write): ',T.ErrorInfo);
IF T.Status <> stOk THEN
T.Reset;
count := T.ReadMsg(idx2,p);
WriteLn('Attempt to re-read: ',T.ErrorInfo);
IF T.Status <> stOk THEN
T.Reset;
Write('"');
FOR loop := 1 TO count DO
Write(CharBuf(p^)[Loop]);
WriteLn('"');
Write('Cleaning up the deletion files. Error returned: ');
T.CleanUpMsg;
WriteLn(T.ErrorInfo);
WriteLn('Re-Index of #1 (Old/New): ',idx1,'/',T.NewIndex(idx1));
WriteLn('Re-Index of #2: ',idx2,'/',T.NewIndex(idx2));
WriteLn('Re-Index of #3: ',idx3,'/',T.NewIndex(idx3));
WriteLn;
WriteLn('Removing Cleanup stuff and restoring old indexes');
T.DeleteCleanUp;
T.Done;
T.Init('TESTFILE.DAT',stOpenRead,128);
count := T.ReadMsg(idx1,p);
WriteLn('Test that is being read back from the file:');
WriteLn('---------------Index 1----------------------------');
FOR loop := 1 TO count DO
Write(CharBuf(p^)[Loop]);
WriteLn;
WriteLn;
count := T.ReadMsg(idx3,p);
WriteLn('---------------Index 3----------------------------');
FOR loop := 1 TO count DO
Write(charbuf(p^)[Loop]);
T.Done;
WriteLn;
WriteLn('-------------------------------------------');
WriteLn('If you want to see what the compressed text looks like');
WriteLn('then use a listing utility to list the file ',T.SFilename);
WriteLn;
WriteLn('Press a key to read a STANDARD text file');
ch := READKEY;
IF ch = #0 THEN
ch := READKEY;
CLRSCR;
T.Init('STORTEST.PAS',stOpenRead,1024);
count := T.ReadMsg(0,p);
FOR loop := 1 TO count DO
Write(CharBuf(p^)[Loop]);
WriteLn;
T.Done;
END.